home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
AMLIST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-04-20
|
9KB
|
295 lines
UNIT AMList;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ File areamanager # Areaman Last changed: 20.04.96 SA ║}
{║ ║}
{║ (C) Copyright 1989-95 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32, OpWindow, OpPick;
TYPE
Alistptr = ^Alist;
AreaSearchFunc = Procedure (A : AlistPtr);
Alist = Object(Picklist)
Temp,
FileMgrWin,
MainFuncKeyWin : WindowPtr;
ShowPath,
movemode : Boolean;
MaxLine : Byte;
FirstShown,
CurrentArea,
Startline,
TopArea,io,
AreaLine : Integer;
FileFinder : AreaSearchFunc;
Constructor InitAreaManager;
DeStructor FinishAreaManager;
PROCEDURE AreaList;
PROCEDURE DiskSpaceStatistics;
PROCEDURE ShowFileAreas;
{ PROCEDURE FindFile; { Original code provided by Steen Buch Christensen }
FUNCTION ChooseFileArea(VAR InKey: Word): Boolean;
END;
IMPLEMENTATION
USES Dos,OpCrt, OpString, OpRoot, OpKey,
AreaMan, Input, Util, OproUtil, FileUtil, KeyBoard, Globals, PopTypes;
Constructor Alist.InitAreaManager;
BEGIN
ShowPath:=FALSE;
movemode:=FALSE;
FirstShown:=0;
CurrentArea:=0;
TopArea:=0;
MyWin(MainFuncKeyWin,1,ScreenHeight-2,80,ScreenHeight,2,'',False);
MyWin(FileMgrWin,1,2,80,ScreenHeight-3,2,'File area manager',False);
AreaLine:=1;
END;
Destructor Alist.FinishAreaManager;
BEGIN
KillWindow(FileMgrWin);
KillWindow(MainFuncKeyWin);
ChangeDir(StartPath);
END;
PROCEDURE Alist.AreaList;
VAR
f : TBufTextFile;
filename:PathStr;
i : Integer;
BEGIN
FileName:=Cfg.BBS.Path+'AREALIST.TXT';
IF InputString(10,8,67,43,3,'Area List','Output Name : ',FileName) THEN
BEGIN
IF f.Init(FileName, SCreate, 2048) THEN
BEGIN
FOR i:=1 TO NumArea DO
WITH Area^[i]^ DO
f.WriteLn(Tag^+' '+title^+CharStr(' ',80-Length(title^))+' '+Path^);
f.Done;
END;
END;
END;
PROCEDURE Alist.DiskSpaceStatistics;
TYPE
TabType=RECORD
Free,
Size : LONGINT;
END;
VAR
Tab : ARRAY['A'..'Z'] OF TabType;
i,l : Byte;
Ch,sd: Char;
s : STRING;
Temp2 : WindowPtr;
TotalSize,TotalFree:LONGINT;
BEGIN
MyWin(Temp2,3,3,78,ScreenHeight,4,'Disk space statistics',False);
With Cfg.Color[4] DO
Temp2^.wFastWrite(Pad('Drive Total Size Free Space %Free Drive Type',Temp2^.Width),1,1,TextColor);
l:=1;
FILLCHAR(tab,SizeOf(Tab),0);
TotalSize:=0; TotalFree:=0;
FOR i:=1 TO NumArea DO
BEGIN
ch:=Area^[i]^.Path^[1];
WITH Tab[ch] DO
IF Size=0 THEN
BEGIN
Size:=DriveSize(ORD(ch)-64);
IF Size>0 THEN
BEGIN
Inc(TotalSize,Size);
Free:=DriveFree(ORD(ch)-64);
Inc(TotalFree,Free);
END;
END;
END;
InOutRes:=0;
FOR ch:='A' TO 'Z' DO
WITH Tab[ch] DO
IF Size<>0 THEN
BEGIN
Inc(l);
s:=' '+ch+': '+LongIntForm('#,###,###,###',Size)+' '+LongIntForm('#,###,###,###',Free)+
Form(' ###.# ',Round(Free)*100.0/Round(Size));
s:=s+GetDiskString(Ch);
Temp2^.wFastWrite(Pad(s,Temp2^.Width),l,1,Cfg.Color[4].HighLightColor);
END;
IF TotalSize>0 THEN
BEGIN
Temp2^.wFastWrite(CharStr('-',Temp2^.Width),l+1,1,Cfg.Color[3].TextColor);
s:='ALL '+LongIntForm('#,###,###,###',TotalSize)+' '+LongIntForm('#,###,###,###',TotalFree)+
Form(' ###.# ',Round(TotalFree)*100.0/Round(TotalSize));
Temp2^.wFastWrite(Pad(s,Temp2^.Width),l+2,1,Cfg.Color[3].TextColor);
END;
REPEAT
UNTIL GotESC;
KillWindow(Temp2);
END;
PROCEDURE Alist.ShowFileAreas;
VAR
S : String;
i : Integer;
Len : Byte;
BEGIN
WITH Temp^ DO
BEGIN
FOR i:=1 TO Height DO
BEGIN
IF i+TopArea<=NumArea THEN
BEGIN
CASE Cfg.BBS.BBSType OF
btMax : Len:=10;
btOpus170 : Len:=6;
ELSE Len:=4;
END;
IF Len<>10 THEN
s:=LeftPad(Area^[i+TopArea]^.tag^,Len)+' '
ELSE
s:=' '+Pad(Trim(Area^[i+TopArea]^.tag^),Len);
IF NOT ShowPath THEN s:=s+' '+Area^[i+TopArea]^.title^
ELSE s:=s+Area^[i+TopArea]^.path^;
IF Length(s)<74 THEN s:=s+charstr(' ',74-Length(s)) ELSE
IF Length(s)>76 THEN s[0]:=#76;
MaxLine:=i;
END ELSE
s:=charstr(' ',76);
wFastWrite(s,i,1,cfg.color[3].TextColor);
END;
IF AreaLine>MaxLine THEN AreaLine:=MaxLine;
END;
END;
FUNCTION Alist.ChooseFileArea(VAR InKey: Word): Boolean;
LABEL Start;
VAR
FuncKeyWin : windowptr;
test,j : Integer;
s : String;
BEGIN
BEGIN
StartLine:=0;
MyWin(FuncKeyWin,1,ScreenHeight-1,80,ScreenHeight,2,'',False);
FuncKeyWin^.wFastWrite('F5=Glob. search',1,64,cfg.color[2].HighLightColor);
FuncKeyWin^.wFastWrite('F7=Area list F8=Disk space F9=Path/title F10=Goto area #',2,16,
cfg.color[2].HighLightColor);
MyWin(Temp,1,2,80,ScreenHeight-2,3,'Choose file area',False);
Start:
ShowFileAreas;
REPEAT
Topic:=50;
CHANGEATTRIBUTE(76,2+AreaLine,3,cfg.color[3].BlockColor);
InKey:=PopReadKeyWord;
CHANGEATTRIBUTE(76,2+AreaLine,3,cfg.color[3].TextColor);
CASE InKey OF
F5 : Filefinder(@Self);
F7 : AreaList;
F8 : DiskSpaceStatistics;
F9 : BEGIN
ShowPath:=NOT ShowPath;
ShowFileAreas;
END;
F10 : BEGIN
s:='';
IF InputString(30,8,9,9,4,'Goto area','Area # : ',s) THEN
BEGIN
j:=0;
REPEAT
Inc(j);
UNTIL (j=NumArea) OR (Trim(s)=Trim(Area^[j]^.tag^));
IF Trim(s)=Trim(Area^[j]^.tag^) THEN
BEGIN
StuffKey(Enter);
TopArea:=j-1;
AreaLine:=1;
END;
END;
END;
Home: BEGIN
TopArea:=0;
ShowFileAreas;
AreaLine:=1;
END;
Up : BEGIN
IF AreaLine>1 THEN Dec(AreaLine) ELSE
IF TopArea>0 THEN
BEGIN
Dec(TopArea);
ShowFileAreas;
END;
END;
PgUp: BEGIN
AreaLine:=AreaLine-Temp^.Height-1;
WHILE AreaLine<1 DO
BEGIN
Inc(AreaLine);
IF TopArea>0 THEN Dec(TopArea);
END;
ShowFileAreas;
END;
EndKey: BEGIN
TopArea:=NumArea-Temp^.Height;
AreaLine:=Temp^.Height;
WHILE TopArea<0 DO
BEGIN
Inc(TopArea);
DEC(AreaLine);
END;
ShowFileAreas;
END;
Down: BEGIN
IF (TopArea+AreaLine<NumArea) AND (AreaLine<MaxLine) THEN Inc(AreaLine) ELSE
IF TopArea+AreaLine<NumArea THEN
BEGIN
Inc(TopArea);
ShowFileAreas;
END;
END;
PgDn: BEGIN
AreaLine:=AreaLine+Temp^.Height-1;
WHILE AreaLine>Temp^.Height DO
BEGIN
Dec(AreaLine);
IF TopArea<NumArea-1 THEN Inc(TopArea);
END;
ShowFileAreas;
END;
END;
UNTIL (InKey=Enter) OR (Inkey=Esc);
IF InKey=Enter THEN
BEGIN
CurrentArea:=TopArea+AreaLine;
IF NOT ChangeDir(Area^[CurrentArea]^.path^) THEN
BEGIN
AskError(8, 'Path for this area does NOT exist', 4);
GOTO Start;
END;
END;
KillWindow(Temp);
KillWindow(FuncKeyWin);
ChooseFileArea:=(InKey<>Esc);
END;
END;
END.